home *** CD-ROM | disk | FTP | other *** search
/ Celestin Apprentice 2 / Apprentice-Release2.iso / Source Code / Pascal / Libraries / DBL Pascal Library / HashTables ƒ / HashTables_Test.p < prev    next >
Encoding:
Text File  |  1993-10-25  |  4.7 KB  |  183 lines  |  [TEXT/PJMM]
  1. program HashTables_Test;
  2.  
  3.     uses
  4.         HashTables;
  5.  
  6.     var
  7.         err: OSErr;
  8.         theTable: HashTable;
  9.         inFile: Text;
  10.         key: Str255;
  11.         value: Str255;
  12.         index: Integer;
  13.         replaced: Boolean;
  14.         entryCount: Longint;
  15.         slotCount: Integer;
  16.         efficiency: Real;
  17.         occupancy: Real;
  18.         state: Longint;
  19.         keyOffset: Longint;
  20.         keyLength: Integer;
  21.         valueOffset: Longint;
  22.         valueLength: Integer;
  23.         dataBlock: Handle;
  24.         recoverableSpace: Longint;
  25.         found: Boolean;
  26.  
  27.     procedure MoveToString (data: Handle; offset: Longint; len: Integer; var result: Str255);
  28.     begin
  29.         BlockMove(Ptr(ORD(data^) + offset), Ptr(ORD(@result) + SIZEOF(SignedByte)), len);
  30. {$PUSH}
  31. {$R-}
  32.         result[0] := CHR(len);
  33. {$POP}
  34.     end;
  35.  
  36.     procedure Bzzt;
  37.     begin
  38.         WriteLn('Bzzt! State=', state : 1, ', key=', key, ', value=', value, '.');
  39.     end;
  40.  
  41.     procedure Stats;
  42.     begin
  43.         err := HashTableSlotCount(theTable, slotCount);
  44.         WriteLn(slotCount : 5, ' slots.');
  45.         err := CountHashEntries(theTable, entryCount);
  46.         WriteLn(entryCount : 5, ' entries.');
  47.         err := HashRecoverableSpace(theTable, recoverableSpace);
  48.         WriteLn(recoverableSpace : 5, ' recoverable bytes.');
  49.         err := HashEfficiency(theTable, efficiency);
  50.         WriteLn(efficiency : 5 : 3, ' efficiency.');
  51.         err := HashSlotOccupancy(theTable, occupancy);
  52.         WriteLn(occupancy : 5 : 3, ' occupancy.');
  53.     end;
  54.  
  55.     procedure Confirm;
  56.     begin
  57.         Reset(inFile);
  58.         index := 1;
  59.         repeat
  60.             ReadLn(inFile, key);
  61.             if key = '' then
  62.                 Cycle;
  63.             value := '';
  64.             err := GetHashEntry(theTable, @key[1], length(key), valueOffset, valueLength, dataBlock, found);
  65.             if not found then
  66.                 Bzzt;
  67.             index := index + 1;
  68.         until EOF(inFile);
  69.     end;
  70.  
  71. begin
  72. {Setup.}
  73.     ShowText;
  74.     Open(inFile, OldFileName('Keys to read…'));
  75.     Reset(inFile);
  76. {Create a test table.}
  77.     WriteLn('• Creating a new hash table.');
  78.     err := NewHashTable(kPrime67, 0, nil, nil, theTable);
  79. {Load the table from a file.}
  80.     WriteLn('• Loading the table.');
  81.     index := 1;
  82.     repeat
  83.         ReadLn(inFile, key);
  84.         if key = '' then
  85.             Cycle;
  86.         value := StringOf(index : 1);
  87.         err := SetHashEntry(theTable, @key[1], length(key), @value[1], length(value), replaced);
  88.         index := index + 1;
  89.     until EOF(inFile);
  90. {Make sure that all the entries exist.}
  91.     WriteLn('• Confirming.');
  92.     Confirm;
  93. {Replace each entry with a longer value.}
  94.     WriteLn('• Replace values (longer)');
  95.     state := 0;
  96.     repeat
  97.         err := GetNextHashEntry(theTable, keyOffset, keyLength, valueOffset, valueLength, dataBlock, state);
  98.         if state <> 0 then
  99.             begin
  100.                 MoveToString(dataBlock, keyOffset, keyLength, key);
  101.                 MoveToString(dataBlock, valueOffset, valueLength, value);
  102.                 value := concat(value, ' ', key);
  103.                 err := SetHashEntry(theTable, @key[1], length(key), @value[1], length(value), replaced);
  104.                 if not replaced then
  105.                     Bzzt;
  106.             end;
  107.     until state = 0;
  108. {Make sure that all the entries exist.}
  109.     WriteLn('• Confirming.');
  110.     Confirm;
  111. {Replace each entry with a shorter value.}
  112.     WriteLn('• Replace values (shorter)');
  113.     state := 0;
  114.     repeat
  115.         err := GetNextHashEntry(theTable, keyOffset, keyLength, valueOffset, valueLength, dataBlock, state);
  116.         if state <> 0 then
  117.             begin
  118.                 MoveToString(dataBlock, keyOffset, keyLength, key);
  119.                 MoveToString(dataBlock, valueOffset, valueLength, value);
  120.                 value := copy(value, pos(' ', value), MAXINT);
  121.                 err := SetHashEntry(theTable, @key[1], length(key), @value[1], length(value), replaced);
  122.                 if not replaced then
  123.                     Bzzt;
  124.             end;
  125.     until state = 0;
  126. {Make sure that all the entries exist.}
  127.     WriteLn('• Confirming.');
  128.     Confirm;
  129. {Report some stats.}
  130.     WriteLn('• Initial stats.');
  131.     Stats;
  132. {Rehash, report stats, and confirm entries a few times.}
  133.     WriteLn('• Rehashing.');
  134.     err := ReHash(theTable, kPrime139);
  135.     Stats;
  136.     WriteLn('• Confirming.');
  137.     Confirm;
  138. {}
  139.     WriteLn('• Rehashing.');
  140.     err := ReHash(theTable, kPrime281);
  141.     Stats;
  142.     WriteLn('• Confirming.');
  143.     Confirm;
  144. {}
  145.     WriteLn('• Rehashing.');
  146.     err := ReHash(theTable, kPrime563);
  147.     Stats;
  148.     WriteLn('• Confirming.');
  149.     Confirm;
  150. {}
  151.     WriteLn('• Rehashing.');
  152.     err := ReHash(theTable, kPrime1129);
  153.     Stats;
  154.     WriteLn('• Confirming.');
  155.     Confirm;
  156. {Delete half of the entries.}
  157.     WriteLn('• Delete half of entries.');
  158.     err := CountHashEntries(theTable, entryCount);
  159.     for index := 1 to entryCount div 2 do
  160.         begin
  161.             state := 0;
  162.             err := GetNextHashEntry(theTable, keyOffset, keyLength, valueOffset, valueLength, dataBlock, state);
  163.             err := RemoveHashEntry(theTable, Ptr(ORD(dataBlock^) + keyOffset), keyLength, found);
  164.             MoveToString(dataBlock, keyOffset, keyLength, key);
  165.             value := '';
  166.             if not found then
  167.                 Bzzt;
  168.         end;
  169.     Stats;
  170. {Compact the table.}
  171.     WriteLn('• Compacting.');
  172.     err := CompactHashSpace(theTable);
  173.     Stats;
  174. {Empty the table.}
  175.     WriteLn('• Emptying.');
  176.     err := EmptyHashTable(theTable);
  177.     Stats;
  178. {Dispose the table.}
  179.     WriteLn('• Disposing.');
  180.     err := DisposeHashTable(theTable);
  181. {Done.}
  182.     Close(inFile);
  183. end.